home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / guile / 1.8 / ice-9 / rdelim.scm < prev    next >
Encoding:
Text File  |  2008-12-17  |  5.3 KB  |  173 lines
  1. ;;; installed-scm-file
  2.  
  3. ;;;; Copyright (C) 1997, 1999, 2000, 2001, 2006 Free Software Foundation, Inc.
  4. ;;;; 
  5. ;;;; This library is free software; you can redistribute it and/or
  6. ;;;; modify it under the terms of the GNU Lesser General Public
  7. ;;;; License as published by the Free Software Foundation; either
  8. ;;;; version 2.1 of the License, or (at your option) any later version.
  9. ;;;; 
  10. ;;;; This library is distributed in the hope that it will be useful,
  11. ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12. ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13. ;;;; Lesser General Public License for more details.
  14. ;;;; 
  15. ;;;; You should have received a copy of the GNU Lesser General Public
  16. ;;;; License along with this library; if not, write to the Free Software
  17. ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18. ;;;; 
  19.  
  20.  
  21. ;;; This is the Scheme part of the module for delimited I/O.  It's
  22. ;;; similar to (scsh rdelim) but somewhat incompatible.
  23.  
  24. (define-module (ice-9 rdelim)
  25.   :export (read-line read-line! read-delimited read-delimited!
  26.        %read-delimited! %read-line write-line)  ; C
  27.   )
  28.  
  29. (%init-rdelim-builtins)
  30.  
  31. (define (read-line! string . maybe-port)
  32.   ;; corresponds to SCM_LINE_INCREMENTORS in libguile.
  33.   (define scm-line-incrementors "\n")
  34.  
  35.   (let* ((port (if (pair? maybe-port)
  36.            (car maybe-port)
  37.            (current-input-port))))
  38.     (let* ((rv (%read-delimited! scm-line-incrementors
  39.                  string
  40.                  #t
  41.                  port))
  42.        (terminator (car rv))
  43.        (nchars (cdr rv)))
  44.       (cond ((and (= nchars 0)
  45.           (eof-object? terminator))
  46.          terminator)
  47.         ((not terminator) #f)
  48.         (else nchars)))))
  49.  
  50. (define (read-delimited! delims buf . args)
  51.   (let* ((num-args (length args))
  52.      (port (if (> num-args 0)
  53.            (car args)
  54.            (current-input-port)))
  55.      (handle-delim (if (> num-args 1)
  56.                (cadr args)
  57.                'trim))
  58.      (start (if (> num-args 2)
  59.             (caddr args)
  60.             0))
  61.      (end (if (> num-args 3)
  62.           (cadddr args)
  63.           (string-length buf))))
  64.     (let* ((rv (%read-delimited! delims
  65.                  buf
  66.                  (not (eq? handle-delim 'peek))
  67.                  port
  68.                  start
  69.                  end))
  70.        (terminator (car rv))
  71.        (nchars (cdr rv)))
  72.       (cond ((or (not terminator)    ; buffer filled
  73.          (eof-object? terminator))
  74.          (if (zero? nchars)
  75.          (if (eq? handle-delim 'split)
  76.              (cons terminator terminator)
  77.              terminator)
  78.          (if (eq? handle-delim 'split)
  79.              (cons nchars terminator)
  80.              nchars)))
  81.         (else
  82.          (case handle-delim
  83.            ((trim peek) nchars)
  84.            ((concat) (string-set! buf (+ nchars start) terminator)
  85.              (+ nchars 1))
  86.            ((split) (cons nchars terminator))
  87.            (else (error "unexpected handle-delim value: " 
  88.                 handle-delim))))))))
  89.   
  90. (define (read-delimited delims . args)
  91.   (let* ((port (if (pair? args)
  92.            (let ((pt (car args)))
  93.              (set! args (cdr args))
  94.              pt)
  95.            (current-input-port)))
  96.      (handle-delim (if (pair? args)
  97.                (car args)
  98.                'trim)))
  99.     (let loop ((substrings '())
  100.            (total-chars 0)
  101.            (buf-size 100))        ; doubled each time through.
  102.       (let* ((buf (make-string buf-size))
  103.          (rv (%read-delimited! delims
  104.                    buf
  105.                    (not (eq? handle-delim 'peek))
  106.                    port))
  107.          (terminator (car rv))
  108.          (nchars (cdr rv))
  109.          (join-substrings
  110.           (lambda ()
  111.         (apply string-append
  112.                (reverse
  113.             (cons (if (and (eq? handle-delim 'concat)
  114.                        (not (eof-object? terminator)))
  115.                   (string terminator)
  116.                   "")
  117.                   (cons (substring buf 0 nchars)
  118.                     substrings))))))
  119.          (new-total (+ total-chars nchars)))
  120.     (cond ((not terminator)
  121.            ;; buffer filled.
  122.            (loop (cons (substring buf 0 nchars) substrings)
  123.              new-total
  124.              (* buf-size 2)))
  125.           ((eof-object? terminator)
  126.            (if (zero? new-total)
  127.            (if (eq? handle-delim 'split)
  128.                (cons terminator terminator)
  129.                terminator)
  130.            (if (eq? handle-delim 'split)
  131.                (cons (join-substrings) terminator)
  132.                (join-substrings))))
  133.           (else
  134.            (case handle-delim
  135.            ((trim peek concat) (join-substrings))
  136.            ((split) (cons (join-substrings) terminator))
  137.  
  138.  
  139.            (else (error "unexpected handle-delim value: "
  140.                 handle-delim)))))))))
  141.  
  142. ;;; read-line [PORT [HANDLE-DELIM]] reads a newline-terminated string
  143. ;;; from PORT.  The return value depends on the value of HANDLE-DELIM,
  144. ;;; which may be one of the symbols `trim', `concat', `peek' and
  145. ;;; `split'.  If it is `trim' (the default), the trailing newline is
  146. ;;; removed and the string is returned.  If `concat', the string is
  147. ;;; returned with the trailing newline intact.  If `peek', the newline
  148. ;;; is left in the input port buffer and the string is returned.  If
  149. ;;; `split', the newline is split from the string and read-line
  150. ;;; returns a pair consisting of the truncated string and the newline.
  151.  
  152. (define (read-line . args)
  153.   (let* ((port        (if (null? args)
  154.                 (current-input-port)
  155.                 (car args)))
  156.      (handle-delim    (if (> (length args) 1)
  157.                 (cadr args)
  158.                 'trim))
  159.      (line/delim    (%read-line port))
  160.      (line        (car line/delim))
  161.      (delim        (cdr line/delim)))
  162.     (case handle-delim
  163.       ((trim) line)
  164.       ((split) line/delim)
  165.       ((concat) (if (and (string? line) (char? delim))
  166.             (string-append line (string delim))
  167.             line))
  168.       ((peek) (if (char? delim)
  169.           (unread-char delim port))
  170.           line)
  171.       (else
  172.        (error "unexpected handle-delim value: " handle-delim)))))
  173.